MODULE RscCoder;

(* Wandelt ein RSC-File in formatierten Text.
 * F�r MM2 als initialisiertes Konstanten-Feld, f�r andere Compiler als
 * CODE- bzw. INLINE-Prozedur.  Ein solches RSC-File kann dann mittels
 * mtRsc.RelocRsc wie ein normales RSC-File geladen werden. So ist es
 * m”glich, Resourcen im Programmcode zu halten, ohne eigenes RSC-File
 * benutzen zu m�ssen.
 *)

IMPORT SYSTEM;
IMPORT MagicSys, MagicAES, MagicConvert, MagicStrings, MagicDOS;
IMPORT mtDir, mtFiles, mtAppl, mtTextfiles, mtTime, mtRsc, mtDials, mtUtils;

(*----------------------------------------------------------------------*
 *        Resource-Coder 1.03  (C)92 by Peter Hellinger Software        *
 *----------------------------------------------------------------------*
 *           Inline-Resource erzeugt am 10.02.1992 17:01:30             *
 *----------------------------------------------------------------------*)
 
TYPE tRscData = ARRAY [0..281] OF CARDINAL;
 
CONST RscData = tRscData {
        00001H, 0013EH, 00122H, 0013EH, 00122H, 00122H, 00024H, 00122H, 00122H, 
        0022EH, 0000AH, 00001H, 00001H, 00000H, 00000H, 00000H, 00000H, 00232H, 
        05253H, 0432DH, 0436FH, 06465H, 07220H, 0312EH, 03033H, 02020H, 02045H, 
        0696EH, 0204DH, 06167H, 06963H, 04C69H, 0622DH, 0546FH, 06F6CH, 00028H, 
        04329H, 03139H, 03932H, 02046H, 05245H, 04557H, 04152H, 04520H, 04259H, 
        02050H, 04554H, 04552H, 02048H, 0454CH, 04C49H, 04E47H, 04552H, 02053H, 
        04F46H, 05457H, 04152H, 04500H, 00000H, 0496EH, 06974H, 06961H, 06C69H, 
        07369H, 06572H, 07465H, 0205BH, 04B6FH, 06E73H, 07461H, 06E74H, 06520H, 
        0286EH, 07572H, 02066H, 08172H, 0204DH, 04D32H, 02900H, 05072H, 06F7AH, 
        06564H, 07572H, 0206DH, 06974H, 0205BH, 0434FH, 04445H, 02D53H, 07461H, 
        07465H, 06D65H, 06E74H, 07320H, 02866H, 08172H, 02054H, 04449H, 02900H, 
        05072H, 06F7AH, 06564H, 07572H, 0206DH, 06974H, 0205BH, 0494EH, 04C49H, 
        04E45H, 02D53H, 07461H, 07465H, 06D65H, 06E74H, 07320H, 0284CH, 05052H, 
        02F53H, 05043H, 02900H, 0415BH, 05252H, 04159H, 0206DH, 06974H, 02049H, 
        06E69H, 07469H, 0616CH, 06973H, 06965H, 07275H, 06E67H, 0732DH, 05072H, 
        06F7AH, 06564H, 07572H, 0005BH, 04F6BH, 0005BH, 04162H, 06272H, 07563H, 
        06800H, 00000H, 00047H, 00000H, 00074H, 00000H, 00075H, 00005H, 00006H, 
        00002H, 00200H, 00000H, 0FFFFH, 0002DH, 00001H, 0FFFFH, 00001H, 00009H, 
        00014H, 00000H, 00010H, 00002H, 01100H, 00001H, 00001H, 00030H, 0000FH, 
        00002H, 0FFFFH, 0FFFFH, 01119H, 00000H, 00010H, 00001H, 01100H, 0002EH, 
        00000H, 00002H, 00001H, 00003H, 0FFFFH, 0FFFFH, 0131CH, 00000H, 00010H, 
        00000H, 00024H, 00002H, 00001H, 0002BH, 00001H, 00004H, 0FFFFH, 0FFFFH, 
        00015H, 00000H, 00000H, 00000H, 00122H, 00002H, 00602H, 00021H, 00001H, 
        00005H, 0FFFFH, 0FFFFH, 0121AH, 00015H, 00001H, 00000H, 00076H, 00002H, 
        00004H, 0002BH, 00001H, 00006H, 0FFFFH, 0FFFFH, 0121AH, 00015H, 00000H, 
        00000H, 0009EH, 00002H, 00006H, 0002BH, 00001H, 00007H, 0FFFFH, 0FFFFH, 
        0121AH, 00015H, 00000H, 00000H, 000C6H, 00002H, 00008H, 0002BH, 00001H, 
        00008H, 0FFFFH, 0FFFFH, 0121AH, 00015H, 00000H, 00000H, 000F0H, 00002H, 
        0000AH, 0002BH, 00001H, 00009H, 0FFFFH, 0FFFFH, 0121AH, 00007H, 00000H, 
        00000H, 00115H, 00015H, 0000DH, 0000BH, 00001H, 00000H, 0FFFFH, 0FFFFH, 
        0121AH, 00425H, 00000H, 00000H, 00119H, 00022H, 0000DH, 0000BH, 00001H, 
        00000H, 0013EH, 00000H
        }; (* Ende RscData *)
(*----------------------------------------------------------------------*)

CONST
  Main     =   0;  (* Formular/Dialog *)
  Formm2   =   4;  (* BUTTON in Baum MAIN *)
  Fortdi   =   5;  (* BUTTON in Baum MAIN *)
  Forother =   6;  (* BUTTON in Baum MAIN *)
  Forarray =   7;  (* BUTTON in Baum MAIN *)
  Ok       =   8;  (* BUTTON in Baum MAIN *)
  Cancel   =   9;  (* BUTTON in Baum MAIN *)




TYPE    tCompiler =     (mm2, tdi, array, other);

VAR     Resource:       ARRAY [0..07FFFH] OF CARDINAL; (* 64kb *)

        inFile:         ARRAY [0..255] OF CHAR;
        inPath:         ARRAY [0..255] OF CHAR;
        inName:         ARRAY [0..14] OF CHAR;
        inSuff:         ARRAY [0..5] OF CHAR;

        outFile:        ARRAY [0..255] OF CHAR;
        outPath:        ARRAY [0..255] OF CHAR;
        outName:        ARRAY [0..14] OF CHAR;
        outSuff:        ARRAY [0..5] OF CHAR;

        str:            ARRAY [0..255] OF CHAR;
        in:             mtFiles.FILE;
        inBytes:        LONGCARD;
        out:            mtTextfiles.TEXTFILE;
        i, j, n, t, d:  CARDINAL;
        b:              BOOLEAN;

VAR     rsc:            mtRsc.RESOURCE;
        main:           mtUtils.tObjcTree;
        clip:           mtUtils.tRect;
        rect:           mtUtils.tRect;
        compiler:       tCompiler;
        objc:           INTEGER;

        

PROCEDURE WriteHex (num: CARDINAL);
VAR str: ARRAY [0..10] OF CHAR;
    i: CARDINAL;
BEGIN
 MagicConvert.NumToStr (LONG(num), 4, 16, FALSE, str);
 FOR i:= 0 TO LENGTH (str) DO
  IF str[i] = ' ' THEN  str[i]:= '0';  END;
 END;
 mtTextfiles.WriteConst (out, '0');
 mtTextfiles.WriteLine (out, str);
 mtTextfiles.WriteConst (out, 'H');
END WriteHex;

PROCEDURE WriteLine (REF str: ARRAY OF CHAR; newline: BOOLEAN);
BEGIN
 mtTextfiles.WriteConst (out, str);
 IF newline THEN  mtTextfiles.WriteLn (out);  END;
END WriteLine;

BEGIN
 compiler:= mm2;
 mtAppl.MouseBusy;
 rect.x:= (mtAppl.MaxWidth DIV 2) - mtAppl.BoxWidth;
 rect.y:= (mtAppl.MaxHeight DIV 2) - mtAppl.BoxHeight;
 rect.w:= mtAppl.BoxWidth * 2;
 rect.h:= mtAppl.BoxHeight * 2;
 IF NOT mtRsc.RelocRsc (SYSTEM.CADR (RscData), rsc) THEN
  mtAppl.ApplTerm (-1);
 END;
 mtAppl.MouseArrow;
 mtAppl.MouseOn;
 MagicAES.WindUpdate (MagicAES.BEGUPDATE);
 main:= mtRsc.GaddrRsc (rsc, MagicAES.RTREE, Main);
 IF NOT mtDials.NewDial (main) THEN  mtAppl.ApplTerm (-1);  END;
 mtDials.DialCenter (main, mtDials.CSCREEN, 0, 0, clip);
 mtDials.DialForm (main, mtDials.DGROW, rect, clip);
 mtDials.DialForm (main, mtDials.DSTART, clip, clip);
 mtDials.DialDraw (main, 0, 8, clip, FALSE);
 LOOP
  mtAppl.MouseArrow;
  objc:= mtDials.DialDo (main, -1);
  b:= mtUtils.DoubleClick (objc);
  IF objc = Formm2 THEN      compiler:= mm2;
  ELSIF objc = Fortdi THEN   compiler:= tdi;
  ELSIF objc = Forother THEN compiler:= other;
  ELSIF objc = Forarray THEN compiler:= array;
  ELSIF objc = Cancel THEN   EXIT;
  ELSIF objc = Ok THEN
   mtAppl.MouseOn;
   IF mtDir.GetDir (inPath, inName, 'Resource w„hlen') THEN
    MagicStrings.Assign (inPath, inFile);
    mtDir.DelTail (inFile);
    MagicStrings.Append (inName, inFile);
    MagicStrings.Assign (inPath, outPath); 
    mtDir.DelTail (outPath);
    MagicStrings.Append ('*.COD', outPath);
    mtDir.Replace (inName, '*.COD', outName);
    mtAppl.MouseOn;
    IF mtDir.GetDir (outPath, outName, 'Codedatei w„hlen') THEN
     mtAppl.MouseBusy;
     MagicStrings.Assign (outPath, outFile);
     mtDir.DelTail (outFile);
     MagicStrings.Append (outName, outFile);
   
     (* Resource-Array l”schen *)
     FOR i:= 0 TO 07FFFH DO  Resource[i]:= 0;  END;

     (* Resource lesen *)
     mtFiles.OpenFile (inFile, in);
     IF in > 0 THEN
      inBytes:= LONG (0FFFFH); (* Max 64kb *)
      mtFiles.ReadFile (in, inBytes, SYSTEM.ADR(Resource));
      mtFiles.CloseFile (in);
     END; 

     (* Eventuell vorhandenes File l”schen *)
     b:= MagicDOS.Fdelete (outFile);
   
     (* Codefile erzeugen *)
     IF mtTextfiles.OpenTextfile (outFile, mtTextfiles.WRITE, 20480, out) THEN
      WriteLine ('(*----------------------------------------------------------------------*', TRUE);
      WriteLine (' *        Resource-Coder 1.03  (C)92 by Peter Hellinger Software        *', TRUE);
      WriteLine (' *----------------------------------------------------------------------*', TRUE);
      WriteLine (' *           Inline-Resource erzeugt am ', FALSE);
      mtTime.DateString (MagicDOS.Tgetdate (), str);  WriteLine (str, FALSE);
      WriteLine (' ', FALSE);
      mtTime.TimeString (MagicDOS.Tgettime (), str);  WriteLine (str, FALSE);
      WriteLine ('             *', TRUE);
      WriteLine (' *----------------------------------------------------------------------*)', TRUE);
      WriteLine (' ', TRUE);
    
      IF compiler = mm2 THEN
       (* Typ schreiben *)
       WriteLine ('TYPE tRscData = ARRAY [0..', FALSE);
       mtTextfiles.WriteCard (out, Resource[17] DIV 2, 0);
       WriteLine ('] OF CARDINAL;', TRUE);  WriteLine (' ', TRUE);

       (* Daten schreiben *)
       WriteLine ('CONST RscData = tRscData {', TRUE);

       j:= 0;  n:= 0;
       LOOP
        IF j > Resource[17] THEN  EXIT  END;
        WriteLine ('        ', FALSE);
        FOR i:= 0 TO 8 DO
         IF j > Resource[17] THEN  EXIT  END;
         WriteHex (Resource[n]);
         IF j # Resource[17] THEN  WriteLine (', ', FALSE);  END;
         INC (n);  INC (j, 2);
        END; (* FOR *)
        mtTextfiles.WriteLn (out);
       END; (* LOOP *)
       mtTextfiles.WriteLn (out);
       WriteLine ('        }; (* Ende RscData *)', TRUE);

      ELSIF compiler = array THEN

       (* Typ schreiben *)
       WriteLine ('VAR  RscData = ARRAY [0..', FALSE);
       mtTextfiles.WriteCard (out, Resource[17] DIV 2, 0);
       WriteLine ('] OF CARDINAL;', TRUE);  WriteLine (' ', TRUE);

       (* Daten schreiben *)
       WriteLine ('PROCEDURE InitRscData;', TRUE);
       WriteLine ('BEGIN', TRUE);

       j:= 0;  n:= 0;
       LOOP
        IF j > Resource[17] THEN  EXIT  END;
        WriteLine (' RscData[', FALSE);
        mtTextfiles.WriteCard (out, n, 0);
        WriteLine (']:= ', FALSE);
        WriteHex (Resource[n]);
        WriteLine ('; ', TRUE);
        INC (n);  INC (j, 2);
       END; (* LOOP *)
       WriteLine ('END InitRscData;', TRUE);

      ELSE
       IF compiler = tdi THEN
        (* Prozedur schreiben *)
        WriteLine ('(*$S-, $T-, $P-*)', TRUE);
       END;
       
       WriteLine ('PROCEDURE RscData;', TRUE);
       WriteLine ('BEGIN', TRUE);
       j:= 0;  n:= 0;
       LOOP
        IF j > Resource[17] THEN  EXIT  END;
        IF compiler = tdi THEN  WriteLine (' CODE (', FALSE);
                          ELSE  WriteLine (' INLINE (', FALSE);
        END;
        FOR i:= 0 TO 7 DO
         IF j > Resource[17] THEN  EXIT  END;
         WriteHex (Resource[n]);
          IF (j # Resource[17]) AND (i # 7) THEN
          WriteLine (', ', FALSE);
         ELSIF i = 7 THEN
          WriteLine (');', FALSE);
         END;
         INC (n); INC (j, 2);
        END; (* FOR *)
        mtTextfiles.WriteLn (out);
       END; (* LOOP *)
       WriteLine (');', TRUE);
       WriteLine ('END RscData;', TRUE);
       IF compiler = tdi THEN  WriteLine ('(*$S=, $T=, $P=*)', TRUE);  END;
       
      END; (* IF compiler *)
      WriteLine ('(*----------------------------------------------------------------------*)', TRUE);
      mtTextfiles.CloseTextfile (out);
     END; (* Opentextfile *)
    END; (* IF GetDir *)
   END; (* IF GetDir *)
   EXCL (main^[objc].obState, MagicAES.SELECTED);
   mtDials.DialDraw (main, objc, 0, clip, FALSE);
  END; (* IF objc = Formm2 *)
 END; (* LOOP *)
 mtDials.DialForm (main, mtDials.DSHRINK, rect, clip);
 mtDials.DialForm (main, mtDials.DFINISH, clip, clip);
 MagicAES.WindUpdate (MagicAES.ENDUPDATE);
 mtAppl.ApplTerm (0);
END RscCoder.

